_require "../../../../basis.smi"
_require "../../../../smlformat-lib.smi"
(* _require "../../../libs/env/main/SEnv.smi" *)
_require "../../../data/symbols/main/Loc.smi"
_require "../../../data/symbols/main/RecordLabel.smi"
(* _require "../../../libs/ids/main/LocalID.smi" *)

_require "../../../data/types/main/Types.ppg.smi"
_require "../../../compilerIRs/absyn/main/ConstFormat.smi"
_require "../../../compilerIRs/typedlambda/main/TypedLambda.ppg.smi"
_require "../../../compilerIRs/recordcalc/main/RecordCalc.ppg.smi"
_require local "../../../libs/util/main/TermFormat.smi"
_require local "../../../extensions/format-utils/main/SmlppgUtil.ppg.smi"
_require "../../../data/name/main/CodeLabel.smi"
_require "../../../data/name/main/ExternSymbol.smi"
_require "../../../data/builtin/main/BuiltinPrimitive.ppg.smi"
_require "../../../data/runtimetypes/main/RuntimeTypes.ppg.smi"
_require "../../../data/runtimetypes/main/FFIAttributes.ppg.smi"

structure ClosureCalc =
struct
  type loc = Loc.loc
  type ty = Types.ty
  type varInfo = TypedLambda.varInfo
  type exVarInfo = Types.exVarInfo
  type primInfo = TypedLambda.primInfo

  datatype ccconst =
      CVINT8 of Int8.int
    | CVINT16 of Int16.int
    | CVINT32 of Int32.int
    | CVINT64 of Int64.int
    | CVWORD8 of Word8.word
    | CVWORD16 of Word16.word
    | CVWORD32 of Word32.word
    | CVWORD64 of Word64.word
    | CVCONTAG of Word32.word
    | CVREAL64 of Real64.real
    | CVREAL32 of Real32.real
    | CVCHAR of Char.char
    | CVUNIT
    | CVNULLPOINTER
    | CVNULLBOXED
    | CVFOREIGNSYMBOL of
      {
        name : string,
        ty : ty
      }
    | CVFUNENTRY of {id: FunEntryLabel.id, codeEntryTy: Types.codeEntryTy}
    | CVFUNWRAPPER of {id: FunEntryLabel.id, codeEntryTy: Types.codeEntryTy}
    | CVEXFUNENTRY of {id: ExternFunSymbol.id, codeEntryTy: Types.codeEntryTy}
    | CVCALLBACKENTRY of
      {
        id: CallbackEntryLabel.id,
        callbackEntryTy: Types.callbackEntryTy
      }
    | CVTOPDATA of {id : DataLabel.id, ty : ty}
    | CVEXTRADATA of ExtraDataLabel.id
    | CVCAST of
      {
        value : ccconst,
        valueTy : ty,
        targetTy : ty,
        cast : BuiltinPrimitive.cast
      }
    | CVTAG of {tag : RuntimeTypes.tag, ty : ty}
    | CVSIZE of {size : RuntimeTypes.size, ty : ty}
    | CVCCONVTAG of Types.codeEntryTy
    | CVWORD32_ORB of ccconst * ccconst

  datatype cconv =
      STATICCALL of Types.codeEntryTy
    | DYNAMICCALL of
      {
        cconvTag: ccexp,
        wrapper: ccexp
      }

  and ccexp =
      CCFOREIGNAPPLY of
      {
        funExp : ccexp,
        argExpList : ccexp list,
        attributes : FFIAttributes.attributes,
        resultTy : ty option,
        loc : loc
      }
    | CCEXPORTCALLBACK of
      {
        codeExp : ccexp,
        closureEnvExp : ccexp,
        instTyvars : Types.btvEnv,
        resultTy : ty,
        loc : loc
      }
    | CCCONST of {const: ccconst, ty: ty, loc: loc}
    | CCINTINF of {srcLabel: ExtraDataLabel.id, loc: loc}
    | CCVAR of {varInfo : varInfo, loc : loc}
    | CCEXVAR of
      {
        id : ExternSymbol.id,
        ty : ty,
        loc : loc
      }
    | CCPRIMAPPLY of
      {
        primInfo : primInfo,
        argExpList : ccexp list,
        instTyList : ty list,
        instTagList : ccexp list,
        instSizeList : ccexp list,
        loc : loc
      }
    | CCCALL of
      {
        codeExp : ccexp,
	closureEnvExp : ccexp,
	argExpList : ccexp list,
	cconv : cconv,
	funTy : ty,
        loc : loc
      }
    | CCLET of
      {
        boundVar : varInfo,
        boundExp : ccexp,
        mainExp : ccexp,
        loc : loc
      }
    | CCRECORD of
      {
        fieldList : {fieldExp : ccexp,
                     fieldTy : ty,
                     fieldLabel : RecordLabel.label,
                     fieldSize : ccexp,
                     fieldTag : ccexp,
                     fieldIndex : ccexp} list,
        recordTy : ty,
        isMutable : bool,
        clearPad : bool,
        allocSizeExp : ccexp,
        bitmaps : {bitmapIndex : ccexp,
                   bitmapExp : ccexp} list,
        loc : loc
      }
    | CCSELECT of
      {
        recordExp : ccexp,
        indexExp : ccexp,
        label : RecordLabel.label,
        recordTy : ty,
        resultTy : ty,
        resultSize : ccexp,
        resultTag : ccexp,
        loc : loc
      }
    | CCMODIFY of
      {
        recordExp : ccexp,
        recordTy : ty,
        indexExp : ccexp,
        label : RecordLabel.label,
        valueExp : ccexp,
        valueTy : ty,
        valueTag : ccexp,
        valueSize : ccexp,
        loc : loc
      }
    | CCRAISE of
      {
        argExp : ccexp,
        resultTy : ty,
        loc : loc
      }
    | CCHANDLE of
      {
        tryExp : ccexp,
        exnVar : varInfo,
        handlerExp : ccexp,
        resultTy : ty,
        loc : loc
      }
    | CCSWITCH of
      {
        switchExp : ccexp,
        expTy : ty,
        branches : {constant : ccconst, branchExp : ccexp} list,
        defaultExp : ccexp,
        resultTy : ty,
        loc : loc
      }
    | CCCATCH of
      {
        catchLabel : FunLocalLabel.id,
        argVarList : varInfo list,
        catchExp : ccexp,
        tryExp : ccexp,
        resultTy : ty,
        loc : loc
      }
    | CCTHROW of
      {
        catchLabel : FunLocalLabel.id,
        argExpList : ccexp list,
        resultTy : ty,
        loc : loc
      }
    | CCCAST of
      {
        exp : ccexp,
        expTy : ty,
        targetTy : ty,
        cast : BuiltinPrimitive.cast,
        loc : loc
      }
    | CCEXPORTVAR of
      {
        id : ExternSymbol.id,
	ty : ty,
	valueExp : ccexp,
	loc : loc
      }

  type topconst = ccconst * ty

  datatype topdec =
      CTFUNCTION of
      {
        id : FunEntryLabel.id,
        tyvarKindEnv : Types.btvEnv,
        argVarList : varInfo list,
        closureEnvVar : varInfo option,
        bodyExp : ccexp,
        retTy : ty,
        loc : loc
      }
    | CTCALLBACKFUNCTION of
      {
        id : CallbackEntryLabel.id,
        tyvarKindEnv : Types.btvEnv,
        argVarList : varInfo list,
        closureEnvVar : varInfo option,
        bodyExp : ccexp,
        attributes : FFIAttributes.attributes,
        retTy : ty option,
        loc : loc
      }

  datatype topdata =
      CTEXTERNVAR of
      {
        id : ExternSymbol.id,
        ty : ty,
        provider : Types.provider,
        loc : loc
      } 
    | CTEXPORTVAR of
      {
        id : ExternSymbol.id,
        weak : bool,
        ty : ty,
        value : topconst option,
        loc : loc
      }
    | CTEXTERNFUN of
      {
        id : ExternFunSymbol.id,
        tyvars : Types.btvEnv,
        argTyList : ty list,
        retTy : ty,
        provider : Types.provider,
        loc : loc
      }
    | CTEXPORTFUN of
      {
        id : ExternFunSymbol.id,
        funId : FunEntryLabel.id,
        loc : loc
      }
    | CTSTRING of
      {
        id : DataLabel.id,
        string : string,
        loc : loc
      }
    | CTINTINF of
      {
        id : ExtraDataLabel.id,
        value : IntInf.int,
        loc : loc
      }
    | CTRECORD of
      {
        id : DataLabel.id,
        tyvarKindEnv : Types.btvEnv,
        fieldList : {fieldExp : topconst,
                     fieldTy : ty,
                     fieldLabel : RecordLabel.label,
                     fieldSize : topconst,
                     fieldIndex : topconst} list,
        recordTy : ty,
        isMutable : bool,
        isCoalescable : bool,
        clearPad : bool,
        bitmaps : {bitmapIndex : topconst,
                   bitmapExp : topconst} list,
        loc : loc
      }
    | CTARRAY of
      {
        id : DataLabel.id,
        elemTy : ty,
        isMutable : bool,
        isCoalescable : bool,
        clearPad : bool,
        numElements : topconst,
        initialElements : topconst list,
        elemSizeExp : topconst,
        tagExp : topconst,
        loc : loc
      }

  type program =
      {
        topdata : topdata list,
        topdecs : topdec list,
        topExp : ccexp
      }

  val format_varInfo
      : varInfo -> SMLFormat.FormatExpression.expression list
  val format_exVarInfo
      : exVarInfo -> SMLFormat.FormatExpression.expression list
  val format_primInfo
      : primInfo -> SMLFormat.FormatExpression.expression list
  val format_ccconst
      : ccconst -> SMLFormat.FormatExpression.expression list
  val format_cconv
      : cconv -> SMLFormat.FormatExpression.expression list
  val format_ccexp
      : ccexp -> SMLFormat.FormatExpression.expression list
  val format_topdec
      : topdec -> SMLFormat.FormatExpression.expression list
  val format_topdata
      : topdata -> SMLFormat.FormatExpression.expression list
  val format_program : program -> SMLFormat.FormatExpression.expression list
  val formatWithType_program
      : program -> SMLFormat.FormatExpression.expression list

end
